home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / plot.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-11-22  |  18.3 KB  |  664 lines
  1. /* plot.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     doublereal atime, aprog[3], adate, atitle[10], defl, defw, defad, defas, 
  12.         rstats[50];
  13.     integer iwidth, lwidth, nopage;
  14. } miscel_;
  15.  
  16. #define miscel_1 miscel_
  17.  
  18. struct {
  19.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  20.         sfactr;
  21.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  22.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  23. } status_;
  24.  
  25. #define status_1 status_
  26.  
  27. struct {
  28.     doublereal twopi, xlog2, xlog10, root2, rad, boltz, charge, ctok, gmin, 
  29.         reltol, abstol, vntol, trtol, chgtol, eps0, epssil, epsox, pivtol,
  30.          pivrel;
  31. } knstnt_;
  32.  
  33. #define knstnt_1 knstnt_
  34.  
  35. struct {
  36.     doublereal xincr, string[15], xstart, yvar[8];
  37.     integer itab[8], itype[8], ilogy[8], npoint, numout, kntr, numdgt;
  38. } outinf_;
  39.  
  40. #define outinf_1 outinf_
  41.  
  42. struct {
  43.     doublereal value[200000];
  44. } blank_;
  45.  
  46. #define blank_1 blank_
  47.  
  48. /* Table of constant values */
  49.  
  50. static integer c__1 = 1;
  51. static integer c__4 = 4;
  52. static integer c__2 = 2;
  53. static integer c__13 = 13;
  54.  
  55. /*<       subroutine plot(numpnt,locx,locy,locv) >*/
  56. /* Subroutine */ int plot_(numpnt, locx, locy, locv)
  57. integer *numpnt, *locx, *locy, *locv;
  58. {
  59.     /* Initialized data */
  60.  
  61.     static struct {
  62.     char e_1[8];
  63.     doublereal e_2;
  64.     } equiv_54 = { {' ', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  65.  
  66. #define ablnk (*(doublereal *)&equiv_54)
  67.  
  68.     static struct {
  69.     char e_1[8];
  70.     doublereal e_2;
  71.     } equiv_55 = { {'x', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  72.  
  73. #define aletx (*(doublereal *)&equiv_55)
  74.  
  75.     static struct {
  76.     char e_1[8];
  77.     doublereal e_2;
  78.     } equiv_56 = { {'.', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  79.  
  80. #define aper (*(doublereal *)&equiv_56)
  81.  
  82.     static struct {
  83.     char e_1[8];
  84.     doublereal e_2;
  85.     } equiv_57 = { {'(', '-', '-', '-', '-', '-', '-', '-'}, 0. };
  86.  
  87. #define asym1 (*(doublereal *)&equiv_57)
  88.  
  89.     static struct {
  90.     char e_1[8];
  91.     doublereal e_2;
  92.     } equiv_58 = { {'-', '-', '-', '-', '-', '-', '-', '-'}, 0. };
  93.  
  94. #define asym2 (*(doublereal *)&equiv_58)
  95.  
  96.     static struct {
  97.     char e_1[8];
  98.     doublereal e_2;
  99.     } equiv_59 = { {')', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
  100.  
  101. #define arprn (*(doublereal *)&equiv_59)
  102.  
  103.     static struct {
  104.     char e_1[8];
  105.     doublereal e_2;
  106.     } equiv_60 = { {'*', '+', '=', '$', '0', '<', '>', '?'}, 0. };
  107.  
  108. #define pltsym (*(doublereal *)&equiv_60)
  109.  
  110.  
  111.     /* Format strings */
  112.     static char fmt_271[] = "(/2a8,\002----\002,1pd12.3,4(15x,d10.3)/26x,51\
  113. (\002 -\002))";
  114.     static char fmt_273[] = "(/2a8,1x,1pd10.3,3(4x,d10.3),1x,d10.3/22x,29\
  115. (\002 -\002))";
  116.     static char fmt_291[] = "(/20x,1pd12.3,4(15x,d10.3)/26x,51(\002 -\002))";
  117.     static char fmt_293[] = "(/15x,1pd12.3,3(4x,d10.3),1x,d10.3/22x,29(\002 \
  118. -\002))";
  119.     static char fmt_316[] = "(1pd10.3,3x,d10.3,3x,13a8)";
  120.     static char fmt_317[] = "(1pd10.3,1x,d10.3,1x,7a8,a1)";
  121.     static char fmt_331[] = "(26x,51(\002 -\002)//)";
  122.     static char fmt_332[] = "(22x,29(\002 -\002)//)";
  123.     static char fmt_401[] = "(\0020warning:  too few points for plotting\002\
  124. /)";
  125.     static char fmt_501[] = "(\002y\002)";
  126.  
  127.     /* System generated locals */
  128.     integer i_1, i_2;
  129.     doublereal d_1, d_2, d_3;
  130.  
  131.     /* Builtin functions */
  132.     double d_lg10(), exp();
  133.     integer s_wsfe(), do_fio(), e_wsfe();
  134.  
  135.     /* Local variables */
  136.     static doublereal pmin[8];
  137.     extern /* Subroutine */ int move_();
  138.     static doublereal asym[2];
  139.     static integer ipos, ktmp;
  140.     static doublereal ymin, ymax, xvar, ymin1, ymax1;
  141.     extern /* Subroutine */ int copy8_();
  142.     static integer i, j, k, l;
  143.     extern /* Subroutine */ int scale_();
  144.     static integer iwide, nwide, icoor[8], jcoor[8];
  145.     static doublereal aplot[13], small, aspot, ycoor[40]    /* was [5][8] 
  146.         */;
  147.     static integer locyt, ispot, lspot;
  148.     static doublereal y1, y2;
  149.     static integer nwide4;
  150.     static doublereal agraph[13];
  151. #define nodplc ((integer *)&blank_1)
  152. #define cvalue ((complex *)&blank_1)
  153.     static doublereal delplt[8];
  154.     static integer mltscl, numcor, jpoint;
  155.     static doublereal del, yvr;
  156.  
  157.     /* Fortran I/O blocks */
  158.     static cilist io__38 = { 0, 0, 0, fmt_271, 0 };
  159.     static cilist io__39 = { 0, 0, 0, fmt_273, 0 };
  160.     static cilist io__40 = { 0, 0, 0, fmt_291, 0 };
  161.     static cilist io__41 = { 0, 0, 0, fmt_293, 0 };
  162.     static cilist io__48 = { 0, 0, 0, fmt_316, 0 };
  163.     static cilist io__49 = { 0, 0, 0, fmt_317, 0 };
  164.     static cilist io__50 = { 0, 0, 0, fmt_331, 0 };
  165.     static cilist io__51 = { 0, 0, 0, fmt_332, 0 };
  166.     static cilist io__52 = { 0, 0, 0, fmt_401, 0 };
  167.     static cilist io__53 = { 0, 0, 0, fmt_501, 0 };
  168.  
  169.  
  170. /*<       implicit double precision (a-h,o-z) >*/
  171.  
  172. /*     this routine generates the line-printer plots. */
  173.  
  174. /* spice version 2g.6  sccsid=miscel 3/15/83 */
  175. /*<       common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad, >*/
  176. /*<      1  defas,rstats(50),iwidth,lwidth,nopage >*/
  177. /* spice version 2g.6  sccsid=status 3/15/83 */
  178. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  179. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  180. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  181. /* spice version 2g.6  sccsid=knstnt 3/15/83 */
  182. /*<       common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok, >*/
  183. /*<      1   gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox, >*/
  184. /*<      2   pivtol,pivrel >*/
  185. /* spice version 2g.6  sccsid=outinf 3/15/83 */
  186. /*<       common /outinf/ xincr,string(15),xstart,yvar(8),itab(8),itype(8), >*/
  187. /*<      1   ilogy(8),npoint,numout,kntr,numdgt >*/
  188. /* spice version 2g.6  sccsid=blank 3/15/83 */
  189. /*<       common /blank/ value(200000) >*/
  190. /*<       integer nodplc(64) >*/
  191. /*<       complex cvalue(32) >*/
  192. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  193.  
  194.  
  195. /*<       integer xxor >*/
  196. /*<       dimension ycoor(5,8),icoor(8),delplt(8) >*/
  197. /*<       dimension agraph(13),aplot(13) >*/
  198. /*<       dimension asym(2),pmin(8),jcoor(8) >*/
  199. /*<       data ablnk, aletx, aper / 1h , 1hx, 1h. / >*/
  200. /*<       data asym1, asym2, arprn / 8h(-------, 8h--------, 1h) / >*/
  201. /*<       data pltsym / 8h*+=$0<>? / >*/
  202.  
  203.  
  204. /*<       iwide=1 >*/
  205.     iwide = 1;
  206. /*<       nwide=101 >*/
  207.     nwide = 101;
  208. /*<       nwide4=25 >*/
  209.     nwide4 = 25;
  210. /*<       if(lwidth.gt.80) go to 3 >*/
  211.     if (miscel_1.lwidth > 80) {
  212.     goto L3;
  213.     }
  214. /*<       iwide=0 >*/
  215.     iwide = 0;
  216. /*<       nwide=57 >*/
  217.     nwide = 57;
  218. /*<       nwide4=14 >*/
  219.     nwide4 = 14;
  220. /*<     3 if (numpnt.le.0) go to 400 >*/
  221. L3:
  222.     if (*numpnt <= 0) {
  223.     goto L400;
  224.     }
  225. /*<       do 5 i=1,13 >*/
  226.     for (i = 1; i <= 13; ++i) {
  227. /*<       agraph(i)=ablnk >*/
  228.     agraph[i - 1] = ablnk;
  229. /*<     5 continue >*/
  230. /* L5: */
  231.     }
  232. /*<       do 7 i=1,5 >*/
  233.     for (i = 1; i <= 5; ++i) {
  234. /*<       ispot=1+nwide4*(i-1) >*/
  235.     ispot = nwide4 * (i - 1) + 1;
  236. /*<       call move(agraph,ispot,aper,1,1) >*/
  237.     move_(agraph, &ispot, &aper, &c__1, &c__1);
  238. /*<     7 continue >*/
  239. /* L7: */
  240.     }
  241. /*<       locyt=locy >*/
  242.     locyt = *locy;
  243. /*<       lspot=locv-1 >*/
  244.     lspot = *locv - 1;
  245. /*<       mltscl=0 >*/
  246.     mltscl = 0;
  247. /*<       if (value(locv).eq.0.0d0) mltscl=1 >*/
  248.     if (blank_1.value[*locv - 1] == 0.) {
  249.     mltscl = 1;
  250.     }
  251. /*<       do 235 k=1,kntr >*/
  252.     i_1 = outinf_1.kntr;
  253.     for (k = 1; k <= i_1; ++k) {
  254. /*<       lspot=lspot+2 >*/
  255.     lspot += 2;
  256. /*<       ymin=value(lspot) >*/
  257.     ymin = blank_1.value[lspot - 1];
  258. /*<       ymax=value(lspot+1) >*/
  259.     ymax = blank_1.value[lspot];
  260. /*<       if (ymin.ne.0.0d0) go to 10 >*/
  261.     if (ymin != 0.) {
  262.         goto L10;
  263.     }
  264. /*<       if (ymax.ne.0.0d0) go to 10 >*/
  265.     if (ymax != 0.) {
  266.         goto L10;
  267.     }
  268. /*<       go to 100 >*/
  269.     goto L100;
  270. /*<    10 ymin1=dmin1(ymin,ymax) >*/
  271. L10:
  272.     ymin1 = min(ymin,ymax);
  273. /*<       ymax1=dmax1(ymin,ymax) >*/
  274.     ymax1 = max(ymin,ymax);
  275. /*<    30 if (ilogy(k).eq.1) go to 40 >*/
  276. /* L30: */
  277.     if (outinf_1.ilogy[k - 1] == 1) {
  278.         goto L40;
  279.     }
  280. /*<       ymin1=dlog10(dmax1(ymin1,1.0d-20)) >*/
  281.     d_1 = max(ymin1,1e-20);
  282.     ymin1 = d_lg10(&d_1);
  283. /*<       ymax1=dlog10(dmax1(ymax1,1.0d-20)) >*/
  284.     d_1 = max(ymax1,1e-20);
  285.     ymax1 = d_lg10(&d_1);
  286. /*<       del=dmax1(ymax1-ymin1,0.0001d0)/4.0d0 >*/
  287. /* Computing MAX */
  288.     d_1 = ymax1 - ymin1;
  289.     del = max(1e-4,d_1) / 4.;
  290. /*<       go to 50 >*/
  291.     goto L50;
  292. /*<    40 del=dmax1(ymax1-ymin1,1.0d-20)/4.0d0 >*/
  293. L40:
  294. /* Computing MAX */
  295.     d_1 = ymax1 - ymin1;
  296.     del = max(1e-20,d_1) / 4.;
  297. /*<    50 ymin=ymin1 >*/
  298. L50:
  299.     ymin = ymin1;
  300. /*<       ymax=ymax1 >*/
  301.     ymax = ymax1;
  302. /*<       go to 200 >*/
  303.     goto L200;
  304.  
  305. /*  determine max and min values */
  306.  
  307. /*<   100 ymax1=value(locyt+1) >*/
  308. L100:
  309.     ymax1 = blank_1.value[locyt];
  310. /*<       ymin1=ymax1 >*/
  311.     ymin1 = ymax1;
  312. /*<       if (numpnt.eq.1) go to 150 >*/
  313.     if (*numpnt == 1) {
  314.         goto L150;
  315.     }
  316. /*<       do 110 i=2,numpnt >*/
  317.     i_2 = *numpnt;
  318.     for (i = 2; i <= i_2; ++i) {
  319. /*<       ymin1=dmin1(ymin1,value(locyt+i)) >*/
  320. /* Computing MAX */
  321.         d_1 = ymin1, d_2 = blank_1.value[locyt + i - 1];
  322.         ymin1 = min(d_2,d_1);
  323. /*<       ymax1=dmax1(ymax1,value(locyt+i)) >*/
  324. /* Computing MAX */
  325.         d_1 = ymax1, d_2 = blank_1.value[locyt + i - 1];
  326.         ymax1 = max(d_2,d_1);
  327. /*<   110 continue >*/
  328. /* L110: */
  329.     }
  330.  
  331. /*  scaling */
  332.  
  333. /*<   150 call scale(ymin1,ymax1,4,ymin,ymax,del) >*/
  334. L150:
  335.     scale_(&ymin1, &ymax1, &c__4, &ymin, &ymax, &del);
  336.  
  337. /*  determine coordinates */
  338.  
  339. /*<   200 ycoor(1,k)=ymin >*/
  340. L200:
  341.     ycoor[k * 5 - 5] = ymin;
  342. /*<       pmin(k)=ymin >*/
  343.     pmin[k - 1] = ymin;
  344. /*<       small=del*1.0d-4 >*/
  345.     small = del * 1e-4;
  346. /*<       if (dabs(ycoor(1,k)).le.small) ycoor(1,k)=0.0d0 >*/
  347.     if ((d_1 = ycoor[k * 5 - 5], abs(d_1)) <= small) {
  348.         ycoor[k * 5 - 5] = 0.;
  349.     }
  350. /*<       do 210 i=1,4 >*/
  351.     for (i = 1; i <= 4; ++i) {
  352. /*<       ycoor(i+1,k)=ycoor(i,k)+del >*/
  353.         ycoor[i + 1 + k * 5 - 6] = ycoor[i + k * 5 - 6] + del;
  354. /*<       if (dabs(ycoor(i+1,k)).le.small) ycoor(i+1,k)=0.0d0 >*/
  355.         if ((d_1 = ycoor[i + 1 + k * 5 - 6], abs(d_1)) <= small) {
  356.         ycoor[i + 1 + k * 5 - 6] = 0.;
  357.         }
  358. /*<   210 continue >*/
  359. /* L210: */
  360.     }
  361. /*<       if (ilogy(k).eq.1) go to 230 >*/
  362.     if (outinf_1.ilogy[k - 1] == 1) {
  363.         goto L230;
  364.     }
  365. /*<       do 220 i=1,5 >*/
  366.     for (i = 1; i <= 5; ++i) {
  367. /*<   220 ycoor(i,k)=dexp(xlog10*ycoor(i,k)) >*/
  368. /* L220: */
  369.         ycoor[i + k * 5 - 6] = exp(knstnt_1.xlog10 * ycoor[i + k * 5 - 6])
  370.             ;
  371.     }
  372. /*<   230 delplt(k)=del/dble(nwide4) >*/
  373. L230:
  374.     delplt[k - 1] = del / (doublereal) nwide4;
  375. /*<       locyt=locyt+npoint >*/
  376.     locyt += outinf_1.npoint;
  377. /*<   235 continue >*/
  378. /* L235: */
  379.     }
  380.  
  381. /*  count distinct coordinates */
  382.  
  383. /*<       icoor(1)=1 >*/
  384.     icoor[0] = 1;
  385. /*<       jcoor(1)=1 >*/
  386.     jcoor[0] = 1;
  387. /*<       numcor=1 >*/
  388.     numcor = 1;
  389. /*<       if (kntr.eq.1) go to 290 >*/
  390.     if (outinf_1.kntr == 1) {
  391.     goto L290;
  392.     }
  393. /*<       do 250 i=2,kntr >*/
  394.     i_1 = outinf_1.kntr;
  395.     for (i = 2; i <= i_1; ++i) {
  396. /*<       do 245 j=1,numcor >*/
  397.     i_2 = numcor;
  398.     for (j = 1; j <= i_2; ++j) {
  399. /*<       l=jcoor(j) >*/
  400.         l = jcoor[j - 1];
  401. /* ...  coordinates are *equal* if the most significant 24 bits 
  402. agree */
  403. /*<       do 240 k=1,5 >*/
  404.         for (k = 1; k <= 5; ++k) {
  405. /* **********************************************************
  406. ******* */
  407. /*  temporarily check 'equality' this way */
  408. /*<       y1=ycoor(k,i) >*/
  409.         y1 = ycoor[k + i * 5 - 6];
  410. /*<       y2=ycoor(k,l) >*/
  411.         y2 = ycoor[k + l * 5 - 6];
  412. /*<       if(y1.eq.0.0d0.and.y2.eq.0.0d0) go to 240 >*/
  413.         if (y1 == 0. && y2 == 0.) {
  414.             goto L240;
  415.         }
  416. /*<       if(dabs((y1-y2)/dmax1(dabs(y1),dabs(y2))).ge.1.0d-7) go to 245 >*/
  417. /* Computing MAX */
  418.         d_2 = abs(y1), d_3 = abs(y2);
  419.         if ((d_1 = (y1 - y2) / max(d_3,d_2), abs(d_1)) >= 1e-7) {
  420.             goto L245;
  421.         }
  422. /*<   240 continue >*/
  423. L240:
  424.         ;}
  425. /*<       icoor(i)=l >*/
  426.         icoor[i - 1] = l;
  427. /*<       go to 250 >*/
  428.         goto L250;
  429. /*<   245 continue >*/
  430. L245:
  431.     ;}
  432. /*<       icoor(i)=i >*/
  433.     icoor[i - 1] = i;
  434. /*<       numcor=numcor+1 >*/
  435.     ++numcor;
  436. /*<       jcoor(numcor)=i >*/
  437.     jcoor[numcor - 1] = i;
  438. /*<   250 continue >*/
  439. L250:
  440.     ;}
  441.  
  442. /*  print coordinates */
  443.  
  444. /*<   260 do 280 i=1,numcor >*/
  445. /* L260: */
  446.     i_1 = numcor;
  447.     for (i = 1; i <= i_1; ++i) {
  448. /*<       asym(1)=asym1 >*/
  449.     asym[0] = asym1;
  450. /*<       asym(2)=asym2 >*/
  451.     asym[1] = asym2;
  452. /*<       ipos=2 >*/
  453.     ipos = 2;
  454. /*<       do 270 j=1,kntr >*/
  455.     i_2 = outinf_1.kntr;
  456.     for (j = 1; j <= i_2; ++j) {
  457. /*<       if (icoor(j).ne.jcoor(i)) go to 270 >*/
  458.         if (icoor[j - 1] != jcoor[i - 1]) {
  459.         goto L270;
  460.         }
  461. /*<       call move(asym,ipos,pltsym,j,1) >*/
  462.         move_(asym, &ipos, &pltsym, &j, &c__1);
  463. /*<       ipos=ipos+1 >*/
  464.         ++ipos;
  465. /*<   270 continue >*/
  466. L270:
  467.     ;}
  468. /*<       call move(asym,ipos,arprn,1,1) >*/
  469.     move_(asym, &ipos, &arprn, &c__1, &c__1);
  470. /*<       k=jcoor(i) >*/
  471.     k = jcoor[i - 1];
  472. /*<       if(iwide.ne.0) write(iofile,271) asym,(ycoor(j,k),j=1,5) >*/
  473.     if (iwide != 0) {
  474.         io__38.ciunit = status_1.iofile;
  475.         s_wsfe(&io__38);
  476.         do_fio(&c__2, (char *)&asym[0], (ftnlen)sizeof(doublereal));
  477.         for (j = 1; j <= 5; ++j) {
  478.         do_fio(&c__1, (char *)&ycoor[j + k * 5 - 6], (ftnlen)sizeof(
  479.             doublereal));
  480.         }
  481.         e_wsfe();
  482.     }
  483. /*<   271 format(/2a8,4h----,1pd12.3,4(15x,d10.3)/26x,51(2h -)) >*/
  484. /*<       if(iwide.eq.0) write(iofile,273) asym,(ycoor(j,k),j=1,5) >*/
  485.     if (iwide == 0) {
  486.         io__39.ciunit = status_1.iofile;
  487.         s_wsfe(&io__39);
  488.         do_fio(&c__2, (char *)&asym[0], (ftnlen)sizeof(doublereal));
  489.         for (j = 1; j <= 5; ++j) {
  490.         do_fio(&c__1, (char *)&ycoor[j + k * 5 - 6], (ftnlen)sizeof(
  491.             doublereal));
  492.         }
  493.         e_wsfe();
  494.     }
  495. /*<   273 format(/2a8,1x,1pd10.3,3(4x,d10.3),1x,d10.3/22x,29(2h -)) >*/
  496. /*<   280 continue >*/
  497. /* L280: */
  498.     }
  499. /*<       go to 300 >*/
  500.     goto L300;
  501. /*<   290 if(iwide.ne.0) write(iofile,291) (ycoor(j,1),j=1,5) >*/
  502. L290:
  503.     if (iwide != 0) {
  504.     io__40.ciunit = status_1.iofile;
  505.     s_wsfe(&io__40);
  506.     for (j = 1; j <= 5; ++j) {
  507.         do_fio(&c__1, (char *)&ycoor[j - 1], (ftnlen)sizeof(doublereal));
  508.     }
  509.     e_wsfe();
  510.     }
  511. /*<   291 format(/20x,1pd12.3,4(15x,d10.3)/26x,51(2h -)) >*/
  512. /*<       if(iwide.eq.0) write(iofile,293) (ycoor(j,1),j=1,5) >*/
  513.     if (iwide == 0) {
  514.     io__41.ciunit = status_1.iofile;
  515.     s_wsfe(&io__41);
  516.     for (j = 1; j <= 5; ++j) {
  517.         do_fio(&c__1, (char *)&ycoor[j - 1], (ftnlen)sizeof(doublereal));
  518.     }
  519.     e_wsfe();
  520.     }
  521. /*<   293 format(/15x,1pd12.3,3(4x,d10.3),1x,d10.3/22x,29(2h -)) >*/
  522.  
  523. /*  plotting */
  524.  
  525. /*<   300 aspot=ablnk >*/
  526. L300:
  527.     aspot = ablnk;
  528. /*<       do 320 i=1,numpnt >*/
  529.     i_1 = *numpnt;
  530.     for (i = 1; i <= i_1; ++i) {
  531. /*<       xvar=value(locx+i) >*/
  532.     xvar = blank_1.value[*locx + i - 1];
  533. /*<       locyt=locy >*/
  534.     locyt = *locy;
  535. /*<       call copy8(agraph,aplot,13) >*/
  536.     copy8_(agraph, aplot, &c__13);
  537. /*<       do 310 k=1,kntr >*/
  538.     i_2 = outinf_1.kntr;
  539.     for (k = 1; k <= i_2; ++k) {
  540. /*<       yvr=value(locyt+i) >*/
  541.         yvr = blank_1.value[locyt + i - 1];
  542. /*<       ktmp=icoor(k) >*/
  543.         ktmp = icoor[k - 1];
  544. /*<       ymin1=pmin(ktmp) >*/
  545.         ymin1 = pmin[ktmp - 1];
  546. /*<       jpoint=idint((yvr-ymin1)/delplt(k)+0.5d0)+1 >*/
  547.         jpoint = (integer) ((yvr - ymin1) / delplt[k - 1] + .5) + 1;
  548. /*<       if (jpoint.le.0) go to 306 >*/
  549.         if (jpoint <= 0) {
  550.         goto L306;
  551.         }
  552. /*<       if (jpoint.gt.nwide) go to 306 >*/
  553.         if (jpoint > nwide) {
  554.         goto L306;
  555.         }
  556. /*<       call move(aspot,1,aplot,jpoint,1) >*/
  557.         move_(&aspot, &c__1, aplot, &jpoint, &c__1);
  558. /*<       if (aspot.eq.ablnk) go to 303 >*/
  559.         if (aspot == ablnk) {
  560.         goto L303;
  561.         }
  562. /*<       if (aspot.eq.aper) go to 303 >*/
  563.         if (aspot == aper) {
  564.         goto L303;
  565.         }
  566. /*<       call move(aplot,jpoint,aletx,1,1) >*/
  567.         move_(aplot, &jpoint, &aletx, &c__1, &c__1);
  568. /*<       go to 306 >*/
  569.         goto L306;
  570. /*<   303 call move(aplot,jpoint,pltsym,k,1) >*/
  571. L303:
  572.         move_(aplot, &jpoint, &pltsym, &k, &c__1);
  573. /*<   306 locyt=locyt+npoint >*/
  574. L306:
  575.         locyt += outinf_1.npoint;
  576. /*<   310 continue >*/
  577. /* L310: */
  578.     }
  579. /*<       yvr=value(locy+i) >*/
  580.     yvr = blank_1.value[*locy + i - 1];
  581. /*<       if (ilogy(1).eq.1) go to 315 >*/
  582.     if (outinf_1.ilogy[0] == 1) {
  583.         goto L315;
  584.     }
  585. /*<       yvr=dexp(xlog10*yvr) >*/
  586.     yvr = exp(knstnt_1.xlog10 * yvr);
  587. /*<   315 if(iwide.ne.0) write(iofile,316) xvar,yvr,aplot >*/
  588. L315:
  589.     if (iwide != 0) {
  590.         io__48.ciunit = status_1.iofile;
  591.         s_wsfe(&io__48);
  592.         do_fio(&c__1, (char *)&xvar, (ftnlen)sizeof(doublereal));
  593.         do_fio(&c__1, (char *)&yvr, (ftnlen)sizeof(doublereal));
  594.         do_fio(&c__13, (char *)&aplot[0], (ftnlen)sizeof(doublereal));
  595.         e_wsfe();
  596.     }
  597. /*<   316 format(1pd10.3,3x,d10.3,3x,13a8) >*/
  598. /*<       if(iwide.eq.0) write(iofile,317) xvar,yvr,(aplot(k),k=1,8) >*/
  599.     if (iwide == 0) {
  600.         io__49.ciunit = status_1.iofile;
  601.         s_wsfe(&io__49);
  602.         do_fio(&c__1, (char *)&xvar, (ftnlen)sizeof(doublereal));
  603.         do_fio(&c__1, (char *)&yvr, (ftnlen)sizeof(doublereal));
  604.         for (k = 1; k <= 8; ++k) {
  605.         do_fio(&c__1, (char *)&aplot[k - 1], (ftnlen)sizeof(
  606.             doublereal));
  607.         }
  608.         e_wsfe();
  609.     }
  610. /*<   317 format(1pd10.3,1x,d10.3,1x,7a8,a1) >*/
  611. /*<   320 continue >*/
  612. /* L320: */
  613.     }
  614.  
  615. /*  finished */
  616.  
  617. /*<       if(iwide.ne.0) write(iofile,331) >*/
  618.     if (iwide != 0) {
  619.     io__50.ciunit = status_1.iofile;
  620.     s_wsfe(&io__50);
  621.     e_wsfe();
  622.     }
  623. /*<   331 format(26x,51(2h -)//) >*/
  624. /*<       if(iwide.eq.0) write(iofile,332) >*/
  625.     if (iwide == 0) {
  626.     io__51.ciunit = status_1.iofile;
  627.     s_wsfe(&io__51);
  628.     e_wsfe();
  629.     }
  630. /*<   332 format(22x,29(2h -)//) >*/
  631. /*<       go to 500 >*/
  632.     goto L500;
  633.  
  634. /*  too few points */
  635.  
  636. /*<   400 write (iofile,401) >*/
  637. L400:
  638.     io__52.ciunit = status_1.iofile;
  639.     s_wsfe(&io__52);
  640.     e_wsfe();
  641. /*<   401 format('0warning:  too few points for plotting'/) >*/
  642. /*<   500 write (iofile,501) >*/
  643. L500:
  644.     io__53.ciunit = status_1.iofile;
  645.     s_wsfe(&io__53);
  646.     e_wsfe();
  647. /*<   501 format(1hy) >*/
  648. /*<       return >*/
  649.     return 0;
  650. /*<       end >*/
  651. } /* plot_ */
  652.  
  653. #undef cvalue
  654. #undef nodplc
  655. #undef pltsym
  656. #undef arprn
  657. #undef asym2
  658. #undef asym1
  659. #undef aper
  660. #undef aletx
  661. #undef ablnk
  662.  
  663.  
  664.